******************************************************************
*                                                                *
*  Data Editor                                                   *
*  © 1988 by Mark E. McBride                                     *
*            1205 Dana Drive                                     *
*            Oxford, OH  45056                                   *
*                                                                *
*  Developed using Absoft MacFortran/020 and FaceIt.             *
*  Program provides a Mac user interface to which number         *
*  crunching routines can easily be added.  Takes advantage      *
*  of FaceIt's general event loop, standard Mac environment,     *
*  sheet windows.                                                *
*                                                                *
******************************************************************

      PROGRAM DataEdit
	real*8 pt(1)
	call main(pt)
	end
	
	Subroutine main(pt)
	implicit none

*  Absoft toolbox parameter equates, change pathname to reflect
*  your disk setup.
	include HD40:Fortran:Include Files:memory.inc
	INTEGER PTR
	PARAMETER (PTR=Z'C0000000')

*  Local variables
	real*8 pt(*)
      integer*4 toolbx,i,j,npt,PtPtr,PtHdl
	integer*4 action,nmax,kmax
	character*256 Head,saveMAC
	logical*1 check
	
      include HD40:Fortran:FaceIt:StorMF.inc

*	load JumpMF	 !!!REMOVE this line if JumpMF is linked to program!!!
*	load toolbx  !!!REMOVE this line if toolbx is linked to program!!!

      name = 'DEdit.Rsrc'           !temporary resource file
      call FaceIt(1,1,-1,50,1,2)    !initialize FaceIt

*  setup default array information
	data nmax/100/
	data kmax/2/
	
*  set initial sheet to 1x1 array so that open command
*  is available, do not hide sheet
*  sheet window must be active window to get open routine
*  called for the sheet.
	PtPtr=0				!pointer to pt array
	PtHdl=0				!handle to pt array

* The use of "1" for the first argument of the SetSh1 command
* indicates that we will support "Open", "Save As", and "Save"
* for this sheet.
	pt(0)=0
	name='empty'
	arrayptr(1) = toolbx(PTR,pt)
	call FaceIt(1,SetSh1,1,1,0,-6)
	call FaceIt(0,ShoSh1,RetCtl,0,0,0)
*
*  Set Means... menu off until an array has been tagged to
*  the sheet.
*
	  call UpdateMenu(menuhdl(5),PtPtr)
	  


*  Main loop
      do
        call FaceIt(0,0,0,0,0,0)           !give control to user
        
	  select case (MAC)
	  
	    case('About')
	      call FaceIt(0,OpnAlt,1009,0,0,0)  !open "About Data Editor" alert

*  The points can be loaded from a DEdit data file.  The data format
*  consists of nmax, kmax, then the kmax string titles, finally, the data.
	    case('Open')
	      Head='opening sheet'
		action=0
		if (PtPtr<>0) then
		  call FaceIt(1,FixSh1,RetCtl,0,0,0)
		  call SaveIt(Head,action)
		end if
		if (action=1)
     +	    call SaveDa(pt,nmax*kmax,nmax,kmax)
		MAC = 'DPTE'
		if (action<3) call FaceIt(0,StdOpn,0,0,0,0)
		if ((name<>'Cancel').and.(action<3)) then
		  if (PtPtr<>0)
     +		call toolbx(DISPOSHANDLE,PtHdl)
		  open(3,file = name,status = 'old',
     +                      form='unformatted')
		  read(3)nmax,kmax
		  I4=nmax*kmax*8
		  call FaceIt(0,NewBlk,0,0,0,0)
		  if (I4<>0) then
		    PtHdl=I4
		    PtPtr=long(I4)
		    call dynam(PtPtr)
		  else
		    MAC='Failed to allocate memory.'
		    call FaceIt(0,OpnAlt,1005,0,0,0)
		    stop
		  end if
		  do (i=1,nmax*kmax)
		    pt(i)=0
		  repeat
		  do (i=1,kmax)
		    read(3)Head
		    MAC=trim(Head)
		    call FaceIt(0,SetStr,1001,i,0,0)
		  repeat
		  read(3)(pt(i),i=1,nmax*kmax)
		  close(3)
		  arrayptr(1) = toolbx(PTR,pt)
		  call FaceIt(1,SetSh1,nmax,kmax,0,-6)
		  fixrect(1)=1;fixrect(2)=1;
		  fixrect(3)=nmax;fixrect(4)=kmax;
		  call FaceIt(1,FixSh1,0,0,0,0)
		end if
		
* We also support the saving of points back to disk...
	    case('Save As','Save')
	      if (MAC='Save As') name=''
		call SaveDa(pt,nmax*kmax,nmax,kmax)
		  
* Create a new array and tag it to the sheet window
	    case('New Sheet')
	      Head='setting new sheet'
		action=0
		if (PtPtr<>0) then
		  call FaceIt(1,FixSh1,RetCtl,0,0,0)
		  call SaveIt(Head,action)
		end if
		if (action=1)
     +	    call SaveDa(pt,nmax*kmax,nmax,kmax)
		check=.false.
		if (action<3) call NewDlg(nmax,kmax,check)
		if ((check).and.(action<3)) then 
	        if (PtPtr<>0)
     +            call toolbx(DISPOSHANDLE,PtHdl)
		  I4=nmax*kmax*8
		  call FaceIt(0,NewBlk,0,0,0,0)
		  if (I4<>0) then
		    PtHdl=I4
		    PtPtr=long(I4)
		    call dynam(PtPtr)
		  else
		    MAC='Failed to allocate memory.'
		    call FaceIt(0,OpnAlt,1005,0,0,0)
		    stop
		  end if
		  do (i=1,nmax*kmax)
		    pt(i)=0
		  repeat
		  name=''
		  do (i=1,kmax)
		    I4=i
		    call FaceIt(0,I4ToS,0,0,0,0)
		    MAC='X'//trim(MAC)
		    call FaceIt(0,SetStr,1001,i,0,0)
		  repeat
		  arrayptr(1) = toolbx(PTR,pt)
		  call FaceIt(1,SetSh1,nmax,kmax,0,-6)
		  fixrect(1)=1;fixrect(2)=1;
		  fixrect(3)=nmax;fixrect(4)=kmax;
		  call FaceIt(1,FixSh1,0,0,0,0)
		end if

	    case('Quit','Transfer')
	      saveMAC=MAC
		if (MAC='Quit')Head='Quitting'
		if (MAC='Transfer')Head='Transferring'
		action=0
		if (PtPtr<>0) then
		  call FaceIt(1,FixSh1,RetCtl,0,0,0)
		  call SaveIt(Head,action)
		end if
		if (action=1)
     +	    call SaveDa(pt,nmax*kmax,nmax,kmax)
		if (action<3) then
		  if (saveMAC='Quit') then
		    call FaceIt(0,DoQuit,0,0,0,0)      !complete Quit
		  else if (saveMAC='Transfer') then
		    call FaceIt(0,DoTran,0,0,0,0)      !complete Transfer
		  end if
		end if

	    case('Means...')
		  call Means(pt,nmax,kmax)
		
	    case default
	  
	  end select

	  call UpdateMenu(menuhdl(5),PtPtr)
	  
	  
	repeat

      end


*
* The following menu-updating routine keeps a single menu item
* updated.
*
	SUBROUTINE UpdateMenu(amenuhdl,aPtr)
	implicit none
      INTEGER ENABLEITEM
      PARAMETER (ENABLEITEM=Z'93911000')
	INTEGER DISABLEITEM
	PARAMETER (DISABLEITEM=Z'93A11000')
	integer*4 amenuhdl,aPtr
	if (aPtr<>0) then				!data in array
	  call toolbx(ENABLEITEM,amenuhdl,1)
	else
	  call toolbx(DISABLEITEM,amenuhdl,1)
	end if
	end

*
*  Write data to output file
*
	Subroutine SaveDa(pt,npts,nmax,kmax)
	implicit none

      real*8 pt(npts)
	integer*4 i,npts,nmax,kmax
	character*256 Head
	
      include HD40:Fortran:FaceIt:StorMF.inc
	
	if (trim(name)='') then
	  MAC = 'Save data points as'
	  call FaceIt(0,StdSav,0,0,0,0)
	end if
	if (name <> 'Cancel') then
	  open(3,file = name,status = 'new',form='unformatted')
	  write(3)nmax,kmax
	  do (i=1,kmax)
	    call FaceIt(0,GetStr,1001,i,0,0)
	    Head=trim(MAC)
	    write(3)Head
	  repeat
	  write(3)(pt(i),i=1,npts)
	  close(3)
	  call FaceIt(1,MovSh1,0,0,0,0)  !reset title
	  MAC = 'DPTE'
	  call FaceIt(0,SetTyp,RetCtl,0,0,0)
      end if
	
	end

*
*  The means subroutine calculates the means of the selected variables
*  Over the selected observations
*
	Subroutine Means(pt,nmax,kmax)
	
	implicit none

	integer*4 nmax,kmax
	real*8 pt(nmax,kmax),sum,xbar
      integer*4 toolbx,i,j
	integer*4 nbeg,nend,kbeg,kend
	character*80 head(10),temp
	logical*1 check

      include HD40:Fortran:FaceIt:StorMF.inc

*  call dialog to get observations and variables

	call SelObs(nbeg,nend,nmax,kmax,check)
	
	if (check) then

*  Write out headers, first select output window
*  then write out information
	  
	  head(1)='Calculated Means'
	  head(2)=''
	  write(temp,'(i5)') nbeg
	  head(3)='Observations:  # '//trim(temp)
	  write(temp,'(i5)') nend
	  head(3)=trim(head(3))//' to # '//trim(temp)
	  head(4)=''
	  do (i=1,4)
	    MAC=head(i)
	    call FaceIt(-1,RetCtl,0,0,0,0)
	  repeat
  
*  Calculate Means and print out results

	  kbeg=0
	  kend=0
	  do (j=1,kmax)
	    call FaceIt(0,GetStr,1001,j,0,0)
	    if (MAC(1:1)='*') then
	      if (kbeg=0) kbeg=j
		if ((kend=0).or.(kbeg>0)) kend=j
	      sum=0
		do (i=nbeg,nend)
		  sum=sum+pt(i,j)
		repeat
		xbar=sum/(nend-nbeg+1)
		write(temp,'(f12.6)') xbar
		call FaceIt(0,GetStr,1001,j,0,0)
		MAC='Mean of '//trim(MAC(2:22))//'= '//trim(temp)
		call FaceIt(-1,RetCtl,0,0,0,0)
	    end if
	  repeat
	  selrect1(1)=nbeg
	  selrect1(3)=nend
	  selrect1(2)=kbeg
	  selrect1(4)=kend
	  fixrect(1)=1;fixrect(2)=1;
	  fixrect(3)=nmax;fixrect(4)=kmax;
	  call FaceIt(0,FixSh1,0,0,0,0)
	end if
	do (j=1,kmax)
	  call FaceIt(0,GetStr,1001,j,0,0)
	  if (MAC(1:1)='*') then
	    MAC=MAC(2:len(trim(MAC)))
	    call FaceIt(0,SetStr,1001,j,0,0)
	  end if
	repeat	
	MAC=' '
	call FaceIt(-1,RetCtl,0,0,0,0)
	MAC=' '
	call FaceIt(-1,RetCtl,0,0,0,0)
	
	end


*
*  Set bounds for a new sheet
*
	subroutine NewDlg(nmax,kmax,check)

	implicit none

      integer*4 toolbx,i,nmax,kmax,avail
	integer*2 mydialog(7)
	logical*1 check
	character*256 oldname
	
*  Absoft toolbox parameter equates, change pathname for your setup
	include HD40:Fortran:Include Files:memory.inc

      include HD40:Fortran:FaceIt:StorMF.inc

	save mydialog
	
	data mydialog/0,0,-2,0,-2,0,-2/

	oldname=name
	write(name,10) nmax,kmax
10	format(2i8)
	do (i = 1,7)
	  dialog(i) = mydialog(i)
	repeat
	check=.false.
	avail=toolbx(COMPACTMEM,8000000)
	while (check<>.true.)
	  call FaceIt(0,OpnDlg,1010,0,0,0)      !open dialog #1010
	  if (dialog(1) = 1) then
	    read(name,12) nmax,kmax
12        format(2i8)
	    if (nmax*kmax*8>avail-20000) then
	      write(MAC,*)'Not enough memory. ',
     +      (avail-20000)/8,' cells available.  ',
     +      'Click to continue.'
		call FaceIt(0,OpnAlt,1005,0,0,0)
	    else
	      check=.true.
		do (i = 1,7)                       !update all values
		  mydialog(i) = dialog(i)
		repeat
	    end if
	  else if (dialog(2)=1) then
	    check=.false.
	    call FaceIt(0,RetCtl,0,0,0,0)		!close dialog window
	    name=oldname
	    return
	  end if
	repeat
	call FaceIt(0,RetCtl,0,0,0,0)		!close dialog window
	
	end


*
*  Set observations to perform means on
*
	subroutine SelObs(nbeg,nend,nmax,kmax,check)

	implicit none

      integer*4 nbeg,nend,nmax,kmax
	integer*4 toolbx,i,j
	integer*2 mydialog(8)
	logical*1 check
	character*256 oldname
	
      include HD40:Fortran:FaceIt:StorMF.inc

 	data mydialog/0,0,-2,0,-2,0,-2,0/

	oldname=name
	write(name,10) selrect1(1),selrect1(3)
10	format(2i8)
	do (j=selrect1(2),selrect1(4))
	  call FaceIt(0,GetStr,1001,j,0,0)
	  MAC='*'//trim(MAC)
	  call FaceIt(0,SetStr,1001,j,0,0)
	repeat
	do (i = 1,8)
	  dialog(i) = mydialog(i)
	repeat
	listID(1)=-1001
	check=.false.
	while (check<>.true.)
	  call FaceIt(0,OpnDlg,1020,0,0,0)         !open dialog #1020
	  if (dialog(1) = 1) then
	    read(name,12) nbeg,nend
12        format(2i8)
	  if (nend>nmax) nend=nmax
	    do (i = 1,8)                          !update all values
		mydialog(i) = dialog(i)
	    repeat
	    check=.true.
	  else if (dialog(2)=1) then
	    call FaceIt(0,RetCtl,0,0,0,0)		!close dialog window
	    check=.false.
	    name=oldname
	    return
	  end if
	repeat
	name=oldname

	call FaceIt(0,RetCtl,0,0,0,0)		      !close dialog window
	
	end


*
*  check whether to save Data before opening
*
	subroutine SaveIt(what,action)

	implicit none

	integer*4 action
	character*256 what
	
      include HD40:Fortran:FaceIt:StorMF.inc

	write(MAC,'(2a64)')trim(name),trim(what)
	call FaceIt(0,OpnAlt,1030,0,0,0)
	action=dialog(1)
	

	end


      include HD40:Fortran:FaceIt:FaceMF.inc
